home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyCollections.p < prev    next >
Text File  |  1995-10-22  |  22KB  |  865 lines
  1. unit MyCollections;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     const
  9.         no_tag = 0;
  10.  
  11.     type
  12.         PermuteArray = array[1..8000] of integer;
  13.         PermuteArrayPtr = ^PermuteArray;
  14.  
  15.     type
  16.         tagType = OSType;
  17.         indexType = longint;
  18.         collection = object
  19.                 error: OSErr; { PUBLIC }
  20.                 safeget: boolean; { PUBLIC }
  21.                 testheap: boolean; { PUBLIC }
  22.  
  23.                 data: handle; { PRIVATE }
  24.                 size: longint; { PRIVATE }
  25.                 cnt: indexType; { PRIVATE }
  26.                 fixed, tagged: boolean; { PRIVATE }
  27.                 lensize, tagsize: longint; { PRIVATE }
  28.                 searchindex: indexType; { PRIVATE }
  29.                 searchtag: tagType; { PRIVATE }
  30.                 cacheoffset: longint; { PRIVATE }
  31.                 cachelen: longint; { PRIVATE }
  32.                 cacheindex: indexType; { PRIVATE }
  33.  
  34.                 procedure Create (siz: longint; fix, tag: boolean);
  35.                 procedure CreateFromHandle (d: handle);
  36.                 procedure Destroy;
  37.                 procedure SetDataHandle (d: handle);
  38.                 function GetDataHandle: handle;
  39.                 procedure Reset;
  40.  
  41.                 function Count: indexType;
  42.  
  43.                 function GetTag (index: indexType): tagType;
  44.                 function GetIndex (tag: tagType): indexType;
  45.  
  46.                 procedure SetTag (index: indexType; tag: tagType);
  47.  
  48.                 function Exists (index: indexType): boolean;
  49.                 function ExistsTag (tag: univ tagType): boolean;
  50.  
  51.                 function Info (index: indexType; var len: longint): boolean;
  52.                 function InfoTag (tag: univ tagType; var len: longint): boolean;
  53.  
  54.                 procedure Delete (index: indexType);
  55.                 procedure DeleteTag (tag: univ tagType);
  56.  
  57.                 procedure InsertBefore (index: indexType);
  58.  
  59.                 procedure Permute (map: PermuteArrayPtr); { WARNING: Destroys permute array data }
  60.  
  61.                 procedure AddBoolean (b: boolean);
  62.                 procedure AddTagBoolean (tag: univ tagType; b: boolean);
  63.                 procedure AddLong (n: univ longint);
  64.                 procedure AddTagLong (tag: univ tagType; n: univ longint);
  65.                 procedure AddString (s: Str255);
  66.                 procedure AddTagString (tag: univ tagType; s: Str255);
  67.                 procedure AddData (p: ptr; len: longint);
  68.                 procedure AddTagData (tag: univ tagType; p: ptr; len: longint);
  69.                 procedure AddItem (p: ptr);
  70.                 procedure AddTagItem (tag: univ tagType; p: ptr);
  71.  
  72.                 procedure SetBoolean (index: indexType; b: boolean);
  73.                 procedure SetTagBoolean (tag: univ tagType; b: boolean);
  74.                 procedure SetLong (index: indexType; n: univ longint);
  75.                 procedure SetTagLong (tag: univ tagType; n: univ longint);
  76.                 procedure SetString (index: indexType; s: Str255);
  77.                 procedure SetTagString (tag: univ tagType; s: Str255);
  78.                 procedure SetData (index: indexType; p: ptr; len: longint);
  79.                 procedure SetTagData (tag: univ tagType; p: ptr; len: longint);
  80.                 procedure SetItem (index: indexType; p: ptr);
  81.                 procedure SetTagItem (tag: univ tagType; p: ptr);
  82.  
  83.                 function GetBoolean (index: indexType): boolean;
  84.                 function GetTagBoolean (tag: univ tagType): boolean;
  85.                 procedure GetLong (index: indexType; var l: univ longint);
  86.                 procedure GetTagLong (tag: univ tagType; var l: univ longint);
  87.                 function GetString (index: indexType): Str255;
  88.                 function GetTagString (tag: univ tagType): Str255;
  89.                 procedure GetData (index: indexType; p: ptr; len: longint);
  90.                 procedure GetTagData (tag: univ tagType; p: ptr; len: longint);
  91.                 procedure GetItem (index: indexType; p: ptr);
  92.                 procedure GetTagItem (tag: univ tagType; p: ptr);
  93.  
  94.                 procedure InvalidateCache;
  95.                 function GetOffset (index: indexType; var offset: longint; var len: longint): boolean; { PRIVATE }
  96.                 function GetTagOffset (tag: univ tagType; var offset: longint; var len: longint; var index: indexType; test: boolean): boolean; { PRIVATE }
  97.                 procedure AddChunk (tag: tagType; p: ptr; len: longint); { PRIVATE }
  98.                 procedure SetChunk (offset, l: longint; tag: tagType; p: ptr; len: longint); { PRIVATE }
  99.                 procedure SetChunkIndex (index: indexType; p: ptr; len: longint); { PRIVATE }
  100.                 procedure SetChunkTag (tag: tagType; p: ptr; len: longint); { PRIVATE }
  101.                 procedure GetChunkIndex (index: indexType; len: longint; p: ptr); { PRIVATE }
  102.                 procedure GetChunkTag (tag: tagType; len: longint; p: ptr); { PRIVATE }
  103.             end;
  104.  
  105.     procedure HackUpdateHandleToCollection (data: handle);
  106.  
  107. implementation
  108.  
  109.     uses
  110.         MyAssertions, MyUtils, MyTypes, MyMemory;
  111.  
  112. { Format is saved in prefs files, so it must not change! }
  113.  
  114.     const
  115.         lsize = 4;
  116.         magic_version = $12345678;
  117.         fixed_bit = 16;
  118.         tagged_bit = 0;
  119.         safeget_bit = 1;
  120.  
  121.     type
  122.         header = record
  123.                 version: longint;
  124.                 size: longint;
  125.                 cnt: indexType;
  126.                 flags: longint;
  127.                 space: longint;
  128.             end;
  129.         headerPtr = ^header;
  130.         headerHandle = ^headerPtr;
  131.  
  132. { Data format: }
  133. { header}
  134. { [tag (lsize)] [length (lsize)] data }
  135.  
  136.     function LongAtPtr (p: univ longintPtr): longint;
  137. {$IFC not GENERATINGPOWERPC}
  138.     inline
  139.         $205F, $224F, $12D8, $12D8, $12D8, $12D8;
  140. { move.l (sp)+,a0 move.l sp,a1, 4*move.b (a0)+,(a1)+ }
  141. {$ELSEC}
  142.     begin
  143.         LongAtPtr:=p^;
  144.     end;
  145. {$ENDC}
  146.  
  147.     function TagAtPtr (p: univ LongIntPtr): tagType;
  148. {$IFC not GENERATINGPOWERPC}
  149.     inline
  150.         $205F, $224F, $12D8, $12D8, $12D8, $12D8;
  151. { move.l (sp)+,a0 move.l sp,a1, 4*move.b (a0)+,(a1)+ }
  152. {$ELSEC}
  153.     begin
  154.         TagAtPtr:=tagType(p^);
  155.     end;
  156. {$ENDC}
  157.  
  158.     function EqualTag(t1, t2: OSType): Boolean;
  159.     begin
  160.         EqualTag := longint(t1) = longint(t2);
  161.     end;
  162.  
  163.     procedure HackUpdateHandleToCollection (data: handle);
  164.         var
  165.             h: header;
  166.             pos: longint;
  167.             size: longint;
  168.     begin
  169.         if (GetHandleSize(data) < SizeOf(header)) | (headerHandle(data)^^.version <> magic_version) then begin
  170.             h.version := magic_version;
  171.             h.size := -1;
  172.             h.flags := 0;
  173.             BSET(h.flags, tagged_bit);
  174.             BSET(h.flags, safeget_bit);
  175.             h.space := 0;
  176.             h.cnt := 0;
  177.             pos := 0;
  178.             while (pos >= 0) & (pos <= GetHandleSize(data) - 8) do begin
  179.                 h.cnt := h.cnt + 1;
  180.                 size := LongAtPtr(ptr(ord(data^) + lsize));
  181.                 if (size < 0) | (size > 1000) then begin
  182.                     pos := -1;
  183.                 end else begin
  184.                     pos := pos + 8 + size;
  185.                 end;
  186.             end;
  187.             if pos <> GetHandleSize(data) then begin
  188.                 SetHandleSize(data, 0);
  189.                 h.cnt := 0;
  190.             end;
  191.             pos := Munger(data, 0, nil, 0, @h, SizeOf(h));
  192.         end;
  193.     end;
  194.  
  195.     procedure collection.Create (siz: longint; fix, tag: boolean);
  196.     begin
  197.         HLock(handle(self));
  198.         data := NewHandle(SizeOf(header));
  199.         size := siz;
  200.         fixed := fix;
  201.         tagged := tag;
  202.         safeget := false;
  203.         testheap := false;
  204.         lensize := lsize * ord(not fixed);
  205.         tagsize := lsize * ord(tagged);
  206.         Reset;
  207.     end;
  208.  
  209.     procedure collection.Destroy;
  210.     begin
  211.         DisposeHandle(data);
  212.         dispose(self);
  213.     end;
  214.  
  215.     function collection.GetDataHandle: handle;
  216.         var
  217.             flags: longint;
  218.     begin
  219.         headerHandle(data)^^.version := magic_version;
  220.         headerHandle(data)^^.size := size;
  221.         headerHandle(data)^^.cnt := cnt;
  222.         flags := 0;
  223.         if fixed then begin
  224.             BSET(flags, fixed_bit);
  225.         end;
  226.         if tagged then begin
  227.             BSET(flags, tagged_bit);
  228.         end;
  229.         if safeget then begin
  230.             BSET(flags, safeget_bit);
  231.         end;
  232.         headerHandle(data)^^.flags := flags;
  233.         headerHandle(data)^^.space := 0;
  234.         GetDataHandle := data;
  235.     end;
  236.  
  237.     procedure collection.SetDataHandle (d: handle);
  238.         var
  239.             flags: longint;
  240.     begin
  241.         if headerHandle(d)^^.version = magic_version then begin
  242.             DisposeHandle(data);
  243.             data := d;
  244.             error := noErr;
  245.             size := headerHandle(data)^^.size;
  246.             cnt := headerHandle(data)^^.cnt;
  247.             flags := headerHandle(data)^^.flags;
  248.             fixed := BTST(flags, fixed_bit);
  249.             tagged := BTST(flags, tagged_bit);
  250.             safeget := BTST(flags, safeget_bit);
  251.             testheap := false;
  252.             lensize := lsize * ord(not fixed);
  253.             tagsize := lsize * ord(tagged);
  254.             InvalidateCache;
  255.         end
  256.         else begin
  257.             Reset;
  258.             error := -1;
  259.         end;
  260.     end;
  261.  
  262.     procedure collection.CreateFromHandle (d: handle);
  263.     begin
  264.         data := NewHandle(SizeOf(header));
  265.         SetDataHandle(d);
  266.     end;
  267.     
  268.     procedure collection.Reset;
  269.     begin
  270.         error := noErr;
  271.         cnt := 0;
  272.         SetHandleSize(data, SizeOf(header));
  273.         InvalidateCache;
  274.     end;
  275.  
  276.     procedure collection.InvalidateCache;
  277.     begin
  278.         cacheoffset := -1;
  279.     end;
  280.  
  281.     procedure collection.Permute (map: PermuteArrayPtr);
  282.         type
  283.             LongArray = array[1..8000] of longint;
  284.             LongArrayPtr = ^LongArray;
  285.         var
  286.             i, j, k: integer;
  287.             offset, src, len, handlesize, result: longint;
  288.             dummy: boolean;
  289.             newdata: handle;
  290.             offsetptr: LongArrayPtr;
  291.             err: OSErr;
  292.     begin
  293.         handlesize := GetHandleSize(data);
  294.         newdata := TempNewHandle(handlesize, err);
  295.         if newdata = nil then begin
  296.             newdata := NewHandle(handlesize);
  297.         end;
  298.         offsetptr := nil;
  299.         if newdata <> nil then begin
  300.             err := MNewPtr(offsetptr, longint(cnt) * 4);
  301.         end;
  302.         if offsetptr <> nil then begin
  303.             offset := SizeOf(header) + tagsize;
  304.             for i := 1 to cnt do begin
  305.                 offsetptr^[i] := offset - tagsize;
  306.                 if fixed then begin
  307.                     offset := offset + size + tagsize;
  308.                 end
  309.                 else begin
  310.                     offset := offset + lsize + LongAtPtr(ptr(ord(data^) + offset)) + tagsize; { point to next length }
  311.                 end;
  312.             end;
  313.             offset := SizeOf(header);
  314.             len := size + tagsize + lensize;
  315.             for i := 1 to cnt do begin
  316.                 src := offsetptr^[map^[i]];
  317.                 if not fixed then begin
  318.                     len := tagsize + LongAtPtr(ptr(ord(data^) + src + tagsize)) + lensize;
  319.                 end;
  320.                 BlockMoveData(ptr(ord(data^) + src), ptr(ord(newdata^) + offset), len);
  321.                 offset := offset + len;
  322.             end;
  323.             Assert(offset = handlesize);
  324.             BlockMoveData(newdata^, data^, handlesize);
  325.             MDisposePtr(offsetptr);
  326.             DisposeHandle(newdata);
  327.         end else begin
  328.             DisposeHandle(newdata); { nil safe }
  329.             for i := 1 to cnt do begin
  330.                 k := map^[i];
  331.                 cacheoffset := -1;
  332.                 dummy := GetOffset(k, offset, len);
  333.                 Assert(dummy);
  334.                 offset := offset - tagsize - lensize;
  335.                 len := len + tagsize + lensize;
  336.                 SetHandleSize(data, handlesize + len);
  337.                 Assert(MemError = noErr);
  338.                 HLock(data);
  339.                 BlockMoveData(ptr(ord(data^) + offset), ptr(ord(data^) + handlesize), len);
  340.                 HUnlock(data);
  341.                 result := Munger(data, offset, nil, len, @data, 0);
  342.                 cacheoffset := -1;
  343.                 for j := 1 to cnt do begin
  344.                     if map^[j] > k then begin
  345.                         map^[j] := map^[j] - 1;
  346.                     end;
  347.                 end;
  348.             end;
  349.         end;
  350.         InvalidateCache;
  351.     end;
  352.  
  353.     function collection.GetOffset (index: indexType; var offset: longint; var len: longint): boolean; { PRIVATE }
  354.         var
  355.             valid: boolean;
  356.             i: indexType;
  357.     begin
  358.         if testheap then begin
  359.             DebugStr('GetOffset;hc;g');
  360.         end;
  361.         valid := (0 < index) & (index <= cnt);
  362.         if valid then begin
  363.             if fixed then begin
  364.                 len := size;
  365.                 offset := SizeOf(header) + (index - 1) * (size + tagsize) + tagsize;
  366.             end
  367.             else begin
  368.                 if (cacheoffset > 0) & (searchindex > 0) & (searchindex <= index) then begin
  369.                     offset := cacheoffset - lsize;
  370.                     i := searchindex;
  371.                 end
  372.                 else begin
  373.                     offset := SizeOf(header) + tagsize; { point to first length }
  374.                     i := 1;
  375.                 end;
  376.                 while (i < index) do begin
  377.                     offset := offset + lsize + LongAtPtr(ptr(ord(data^) + offset)) + tagsize; { point to next length }
  378.                     i := i + 1;
  379.                 end;
  380.                 len := LongAtPtr(ptr(ord(data^) + offset));
  381.                 offset := offset + lsize; { point to data }
  382.             end;
  383.             cacheoffset := offset;
  384.             cachelen := len;
  385.             searchindex := index;
  386.         end
  387.         else begin
  388.             Assert(false);
  389.             InvalidateCache;
  390.         end;
  391.         GetOffset := valid;
  392.     end;
  393.  
  394.     function collection.GetTagOffset (tag: univ tagType; var offset: longint; var len: longint; var index: indexType; test: boolean): boolean; { PRIVATE }
  395.         var
  396.             valid: boolean;
  397.             t: tagType;
  398.             handlesize: longint;
  399.     begin
  400.         if testheap then begin
  401.             DebugStr('GetTagOffset;hc;g');
  402.         end;
  403.         valid := false;
  404.         if tagged then begin
  405.             if (cacheoffset > 0) & (searchindex < 0) & EqualTag(searchtag, tag) then begin
  406.                 offset := cacheoffset;
  407.                 len := cachelen;
  408.                 index := cacheindex;
  409.                 valid := true;
  410.             end
  411.             else begin
  412.                 len := size;
  413.                 index := 0;
  414.                 offset := SizeOf(header); { point to first tag }
  415.                 handlesize := GetHandleSize(data);
  416.                 while (not valid) & (index < cnt) do begin
  417.                     Assert((0 < offset) & (offset < handlesize));
  418.                     t := TagAtPtr(ptr(ord(data^) + offset));
  419.                     if not fixed then begin
  420.                         len := LongAtPtr(ptr(ord(data^) + offset + tagsize));
  421.                     end;
  422.                     offset := offset + tagsize + lensize + len; { point to next tag }
  423.                     index := index + 1;
  424.                     valid := EqualTag(t, tag);
  425.                 end;
  426.                 offset := offset - len; { point to data }
  427.             end;
  428.         end;
  429.         if not test then begin
  430.             Assert(valid);
  431.         end;
  432.         if valid then begin
  433.             cacheoffset := offset;
  434.             cachelen := len;
  435.             cacheindex := index;
  436.             searchindex := -1;
  437.             searchtag := tag;
  438.         end
  439.         else begin
  440.             InvalidateCache;
  441.         end;
  442.         GetTagOffset := valid;
  443.     end;
  444.  
  445.     function collection.Count: indexType;
  446.     begin
  447.         Count := cnt;
  448.     end;
  449.  
  450.     function collection.GetTag (index: indexType): tagType;
  451.         var
  452.             offset, len: longint;
  453.     begin
  454.         GetTag := tagType(no_tag);
  455.         Assert(tagged);
  456.         if GetOffset(index, offset, len) then begin
  457.             GetTag := TagAtPtr(ptr(ord(data^) + offset - lensize - tagsize));
  458.         end;
  459.     end;
  460.  
  461.     procedure collection.SetTag (index: indexType; tag: tagType);
  462.         var
  463.             offset, len: longint;
  464.     begin
  465.         Assert(tagged);
  466.         if GetOffset(index, offset, len) then begin
  467.             BlockMoveData(@tag, ptr(ord(data^) + offset - lensize - tagsize), tagsize);
  468.         end;
  469.     end;
  470.  
  471.     function collection.GetIndex (tag: tagType): indexType;
  472.         var
  473.             offset, len: longint;
  474.             index: indexType;
  475.     begin
  476.         GetIndex := 0;
  477.         if GetTagOffset(tag, offset, len, index, true) then begin
  478.             GetIndex := index;
  479.         end;
  480.     end;
  481.  
  482.     function collection.Info (index: indexType; var len: longint): boolean;
  483.         var
  484.             offset: longint;
  485.     begin
  486.         Info := (1 <= index) & (index <= cnt) & GetOffset(index, offset, len);
  487.     end;
  488.  
  489.     function collection.InfoTag (tag: univ tagType; var len: longint): boolean;
  490.         var
  491.             offset: longint;
  492.             index: indexType;
  493.     begin
  494. {        DebugStr(concat('InfoTag ',NumToStr(longint(tag)),';g'));}
  495.         InfoTag := GetTagOffset(tag, offset, len, index, true);
  496.     end;
  497.  
  498.     function collection.Exists (index: indexType): boolean;
  499.         var
  500.             len: longint;
  501.     begin
  502.         Exists := Info(index, len);
  503.     end;
  504.  
  505.     function collection.ExistsTag (tag: univ tagType): boolean;
  506.         var
  507.             len: longint;
  508.     begin
  509.         ExistsTag := InfoTag(tag, len);
  510.     end;
  511.  
  512.     procedure collection.Delete (index: indexType);
  513.         var
  514.             offset, len: longint;
  515.     begin
  516.         if GetOffset(index, offset, len) then begin
  517.             offset := Munger(data, offset - tagsize - lensize, nil, tagsize + lensize + len, @offset, 0);
  518.             cnt := cnt - 1;
  519.             InvalidateCache;
  520.         end;
  521.     end;
  522.  
  523.     procedure collection.DeleteTag (tag: univ tagType);
  524.         var
  525.             offset, len: longint;
  526.             index: indexType;
  527.     begin
  528.         if GetTagOffset(tag, offset, len, index, true) then begin
  529.             offset := Munger(data, offset - tagsize - lensize, nil, tagsize + lensize + len, @offset, 0);
  530.             cnt := cnt - 1;
  531.             InvalidateCache;
  532.         end;
  533.     end;
  534.  
  535.     procedure collection.AddChunk (tag: tagType; p: ptr; len: longint);
  536.         var
  537.             orgsize: longint;
  538.     begin
  539.         if testheap then begin
  540.             DebugStr('AddChunk Enter;hc;g');
  541.         end;
  542.         if error = noErr then begin
  543.             orgsize := GetHandleSize(data);
  544.             SetHandleSize(data, orgsize + tagsize + lensize + len);
  545.             if MemError = noErr then begin
  546.                 if tagged then begin
  547.                     BlockMoveData(@tag, ptr(ord(data^) + orgsize), lsize);
  548.                     orgsize := orgsize + lsize;
  549.                 end
  550.                 else begin
  551.                     Assert(EqualTag(tag, tagType(no_tag)));
  552.                 end;
  553.                 if not fixed then begin
  554.                     BlockMoveData(@len, ptr(ord(data^) + orgsize), lsize);
  555.                     orgsize := orgsize + lsize;
  556.                 end
  557.                 else begin
  558.                     Assert(len = size);
  559.                 end;
  560.                 BlockMoveData(p, ptr(ord(data^) + orgsize), len);
  561.                 cnt := cnt + 1;
  562.             end;
  563.         end;
  564.         if testheap then begin
  565.             DebugStr('AddChunk Exit;hc;g');
  566.         end;
  567.     end;
  568.  
  569.     procedure collection.InsertBefore (index: indexType);
  570.         var
  571.             offset, len, oe: longint;
  572.             t: tagType;
  573.     begin
  574.         t := tagType(no_tag);
  575.         if index = Count + 1 then begin
  576.             if fixed then begin
  577.                 AddChunk(t, @index, size);
  578.             end
  579.             else begin
  580.                 AddChunk(t, @index, 0);
  581.             end;
  582.         end
  583.         else begin
  584.             if GetOffset(index, offset, len) then begin
  585.                 offset := offset - lensize - tagsize;
  586.                 if tagged then begin
  587.                     oe := Munger(data, offset, nil, 0, @t, tagsize);
  588.                     offset := offset + tagsize;
  589.                 end;
  590.                 if fixed then begin
  591.                     oe := Munger(data, offset, nil, 0, @index, size);
  592.                 end
  593.                 else begin
  594.                     len := 0;
  595.                     oe := Munger(data, offset, nil, 0, @len, lensize);
  596.                 end;
  597.                 if error = noErr then begin
  598.                     error := MemError;
  599.                 end;
  600.                 cnt := cnt + 1;
  601.                 InvalidateCache;
  602.             end;
  603.         end;
  604.     end;
  605.  
  606.     procedure collection.SetChunk (offset, l: longint; tag: tagType; p: ptr; len: longint);
  607.     begin
  608.         if tagged then begin
  609.             BlockMoveData(@tag, ptr(ord(data^) + offset - lensize - tagsize), tagsize);
  610.         end
  611.         else begin
  612.             Assert(EqualTag(tag, tagType(no_tag)));
  613.         end;
  614.         if fixed then begin
  615.             Assert(len = size);
  616.         end;
  617.         if l = len then begin
  618.             BlockMoveData(p, ptr(ord(data^) + offset), len);
  619.         end
  620.         else begin
  621.             BlockMoveData(@len, ptr(ord(data^) + offset - lensize), lensize);
  622.             offset := Munger(data, offset, nil, l, p, len);
  623.             if error = noErr then begin
  624.                 error := MemError;
  625.             end;
  626.         end;
  627.         InvalidateCache;
  628.     end;
  629.  
  630.     procedure collection.SetChunkIndex (index: indexType; p: ptr; len: longint);
  631.         var
  632.             offset, l: longint;
  633.     begin
  634.         if GetOffset(index, offset, l) then begin
  635.             SetChunk(offset, l, tagType(no_tag), p, len);
  636.         end;
  637.     end;
  638.  
  639.     procedure collection.SetChunkTag (tag: tagType; p: ptr; len: longint);
  640.         var
  641.             offset, l: longint;
  642.             index: indexType;
  643.     begin
  644.         if GetTagOffset(tag, offset, l, index, true) then begin
  645.             SetChunk(offset, l, tag, p, len);
  646.         end
  647.         else begin
  648.             AddChunk(tag, p, len);
  649.         end;
  650.     end;
  651.  
  652.     procedure collection.GetChunkIndex (index: indexType; len: longint; p: ptr);
  653.         var
  654.             offset, l: longint;
  655.     begin
  656.         if GetOffset(index, offset, l) then begin
  657.             Assert(l = len);
  658.             BlockMoveData(ptr(ord(data^) + offset), p, len);
  659.         end;
  660.     end;
  661.  
  662.     procedure collection.GetChunkTag (tag: tagType; len: longint; p: ptr);
  663.         var
  664.             offset, l: longint;
  665.             index: indexType;
  666.     begin
  667.         if GetTagOffset(tag, offset, l, index, safeget) then begin
  668.             Assert(l = len);
  669.             BlockMoveData(ptr(ord(data^) + offset), p, len);
  670.         end
  671.         else begin
  672.             MZero(p, len);
  673.         end;
  674.     end;
  675.  
  676.     procedure collection.AddBoolean (b: boolean);
  677.         var
  678.             n: integer;
  679.     begin
  680.         n := -ord(b);
  681.         AddChunk(tagType(no_tag), @n, 1);
  682.     end;
  683.  
  684.     procedure collection.AddTagBoolean (tag: univ tagType; b: boolean);
  685.         var
  686.             n: integer;
  687.     begin
  688.         n := -ord(b);
  689.         AddChunk(tag, @n, 1);
  690.     end;
  691.  
  692.     procedure collection.AddLong (n: univ longint);
  693.     begin
  694.         AddChunk(tagType(no_tag), @n, lsize);
  695.     end;
  696.  
  697.     procedure collection.AddTagLong (tag: univ tagType; n: univ longint);
  698.     begin
  699.         AddChunk(tag, @n, lsize);
  700.     end;
  701.  
  702.     procedure collection.AddString (s: Str255);
  703.     begin
  704.         AddChunk(tagType(no_tag), @s[1], length(s));
  705.     end;
  706.  
  707.     procedure collection.AddTagString (tag: univ tagType; s: Str255);
  708.     begin
  709.         AddChunk(tag, @s[1], length(s));
  710.     end;
  711.  
  712.     procedure collection.AddData (p: ptr; len: longint);
  713.     begin
  714.         AddChunk(tagType(no_tag), p, len);
  715.     end;
  716.  
  717.     procedure collection.AddTagData (tag: univ tagType; p: ptr; len: longint);
  718.     begin
  719.         AddChunk(tag, p, len);
  720.     end;
  721.  
  722.     procedure collection.AddItem (p: ptr);
  723.     begin
  724.         AddChunk(tagType(no_tag), p, size);
  725.     end;
  726.  
  727.     procedure collection.AddTagItem (tag: univ tagType; p: ptr);
  728.     begin
  729.         AddChunk(tag, p, size);
  730.     end;
  731.  
  732.     procedure collection.SetBoolean (index: indexType; b: boolean);
  733.         var
  734.             n: integer;
  735.     begin
  736.         n := -ord(b);
  737.         SetChunkIndex(index, @n, 1);
  738.     end;
  739.  
  740.     procedure collection.SetTagBoolean (tag: univ tagType; b: boolean);
  741.         var
  742.             n: integer;
  743.     begin
  744.         n := -ord(b);
  745.         SetChunkTag(tag, @n, 1);
  746.     end;
  747.  
  748.     procedure collection.SetLong (index: indexType; n: univ longint);
  749.     begin
  750.         SetChunkIndex(index, @n, lsize);
  751.     end;
  752.  
  753.     procedure collection.SetTagLong (tag: univ tagType; n: univ longint);
  754.     begin
  755.         SetChunkTag(tag, @n, lsize);
  756.     end;
  757.  
  758.     procedure collection.SetString (index: indexType; s: Str255);
  759.     begin
  760.         SetChunkIndex(index, @s[1], length(s));
  761.     end;
  762.  
  763.     procedure collection.SetTagString (tag: univ tagType; s: Str255);
  764.     begin
  765.         SetChunkTag(tag, @s[1], length(s));
  766.     end;
  767.  
  768.     procedure collection.SetData (index: indexType; p: ptr; len: longint);
  769.     begin
  770.         SetChunkIndex(index, p, len);
  771.     end;
  772.  
  773.     procedure collection.SetTagData (tag: univ tagType; p: ptr; len: longint);
  774.     begin
  775.         SetChunkTag(tag, p, len);
  776.     end;
  777.  
  778.     procedure collection.SetItem (index: indexType; p: ptr);
  779.     begin
  780.         SetChunkIndex(index, p, size);
  781.     end;
  782.  
  783.     procedure collection.SetTagItem (tag: univ tagType; p: ptr);
  784.     begin
  785.         SetChunkTag(tag, p, size);
  786.     end;
  787.  
  788.     function collection.GetBoolean (index: indexType): boolean;
  789.         var
  790.             n: integer;
  791.     begin
  792.         n := 0;
  793.         GetChunkIndex(index, 1, @n);
  794.         GetBoolean := n <> 0;
  795.     end;
  796.  
  797.     function collection.GetTagBoolean (tag: univ tagType): boolean;
  798.         var
  799.             n: integer;
  800.     begin
  801.         n := 0;
  802.         GetChunkTag(tag, 1, @n);
  803.         GetTagBoolean := n <> 0;
  804.     end;
  805.  
  806.     procedure collection.GetLong (index: indexType; var l: univ longint);
  807.     begin
  808.         GetChunkIndex(index, 4, @l);
  809.     end;
  810.  
  811.     procedure collection.GetTagLong (tag: univ tagType; var l: univ longint);
  812.     begin
  813.         GetChunkTag(tag, 4, @l);
  814.     end;
  815.  
  816.     function collection.GetString (index: indexType): Str255;
  817.         var
  818.             offset, l: longint;
  819.             s: Str255;
  820.     begin
  821.         s := '';
  822.         if GetOffset(index, offset, l) then begin
  823.             Assert(l <= 255);
  824.             BlockMoveData(ptr(ord(data^) + offset), @s[1], l);
  825.             s[0] := chr(l);
  826.         end;
  827.         GetString := s;
  828.     end;
  829.  
  830.     function collection.GetTagString (tag: univ tagType): Str255;
  831.         var
  832.             offset, l: longint;
  833.             index: indexType;
  834.             s: Str255;
  835.     begin
  836.         s := '';
  837.         if GetTagOffset(tag, offset, l, index, safeget) then begin
  838.             Assert(l <= 255);
  839.             BlockMoveData(ptr(ord(data^) + offset), @s[1], l);
  840.             s[0] := chr(l);
  841.         end;
  842.         GetTagString := s;
  843.     end;
  844.  
  845.     procedure collection.GetData (index: indexType; p: ptr; len: longint);
  846.     begin
  847.         GetChunkIndex(index, len, p);
  848.     end;
  849.  
  850.     procedure collection.GetTagData (tag: univ tagType; p: ptr; len: longint);
  851.     begin
  852.         GetChunkTag(tag, len, p);
  853.     end;
  854.  
  855.     procedure collection.GetItem (index: indexType; p: ptr);
  856.     begin
  857.         GetChunkIndex(index, size, p);
  858.     end;
  859.  
  860.     procedure collection.GetTagItem (tag: univ tagType; p: ptr);
  861.     begin
  862.         GetChunkTag(tag, size, p);
  863.     end;
  864.  
  865. end.